ОС.отд
Главная     ◄Глагол     ◄Азбука     ◄Задачи на Глаголе     Примеры приложений ►   Среда разработки ►   Отладка программ ►   Отличия от Оберона ►   Отличия от Паскаля ►   Ассемблер ARM ►   Глагол для ARM ►   ? и Ответы
 
 glagol.png Программируем по-русски
 

Основная задача Глагола — дать человеку возможность воплощать свои мысли на языке, близком к его родному языку.

Издатель Глагола
 

 

(******************************************************************************)
(**)                        ОТДЕЛ ОС;
(****************************************************************************** 
 * НАЗНАЧЕНИЕ: взаимодействие с операционной системой (Win32).
 ******************************************************************************)
ИСПОЛЬЗУЕТ
  ОБХОД,
  Буква ИЗ "..\Иное\",
  Цепь  ИЗ "..\Иное\";

ПОСТ
  (* наибольшие длины (с учетом конечного 0X) *)
  длПутиФ-    =260;   (* пути к файлу                     *)
  длИмениФ-   =256;   (* имени файла без типа файла       *)
  длТипаФ-    =5;     (* типа файла с начальной "."       *)
  длКорИмениФ-=14;    (* короткого имени с типом файла    *)
  длПолногоФ- =длПутиФ+длИмениФ;  (* полного имени файла *)

  (* свойства файлов *)
  сфТолькоЧтение- =0;
  сфНевидимый-    =1;
  сфСистемный-    =2;
  сфНазваниеДиска-=3;
  сфКаталог-      =4;
  сфАрхивный-     =5;
  сфОбычный-      =7;
  сфОшибкаЧтения- =31;

(* файлы *)
ВИД
  (* время *)
  ВремяФ-=ОБХОД.Цел64;

  (* поиск + фссылка *)
  ПоискФ-=НАБОР
    свойства-        :МНОЖ;       (* использовалось в СвойстваИзПоискаФ() *)
    времяСоздания-   :ВремяФ;              
    времяПослДоступа-:ВремяФ;              
    времяПослЗаписи- :ВремяФ;              
    размерСтарш-     :ЦЕЛ;                 
    размерМладш-     :ЦЕЛ;        (* использовалось в РазмерИзПоискаФ() *)
    прозапас0        :ЦЕЛ;                 
    прозапас1        :ЦЕЛ;                 
    имя-             :РЯД длПутиФ ИЗ ЗНАК; (* использовалось в ИмяИзПоискаФ() *)
    короткоеИмя-     :РЯД длКорИмениФ ИЗ ЗНАК;      
    фссылка          :ЦЕЛ;                 (* добавок *)      
  КОН;

  (* текущее время *)
  Сейчас-=НАБОР
    год-     :ОБХОД.Цел16; (* год                *)
    месяц-   :ОБХОД.Цел16; (* 1-январь, ...      *)
    деньНед- :ОБХОД.Цел16; (* 0-воскресенье, ... *)
    день-    :ОБХОД.Цел16; (* день месяца        *)
    час-     :ОБХОД.Цел16; (* час                *)
    минута-  :ОБХОД.Цел16; (* минута             *)
    секунда- :ОБХОД.Цел16; (* секунда            *)
    мсекунда-:ОБХОД.Цел16; (* миллисекунда       *)
  КОН;
 
ПЕР
  русРаскладка:ЦЕЛ;   (* раскладка клавиатуры для русского языка *)
  латРаскладка:ЦЕЛ;   (* раскладка клавиатуры для английского языка *)

  ссылкаНаВвод-:ЦЕЛ;  (* ссылка на встроенный файл ввода  *)
  ссылкаНаВывод-:ЦЕЛ; (* ссылка на встроенный файл вывода *)
  ссылкаНаСтог:ЦЕЛ;   (* ссылка на встроенный стог памяти *)

(* используемые Win виды *)
ВИД
  SECURITY_ATTRIBUTES=НАБОР
    nLength             :ЦЕЛ; 
    lpSecurityDescriptor:ЦЕЛ; 
    bInheritHandle      :ЦЕЛ; 
  КОН;
  STARTUPINFO=НАБОР
    cb                  :ЦЕЛ; 
    lpReserved          :ЦЕЛ; 
    lpDesktop           :ЦЕЛ; 
    lpTitle             :ЦЕЛ; 
    dwX                 :ЦЕЛ;                   
    dwY                 :ЦЕЛ; 
    dwXSize             :ЦЕЛ;               
    dwYSize             :ЦЕЛ; 
    dwXCountChars       :ЦЕЛ; 
    dwYCountChars       :ЦЕЛ; 
    dwFillAttribute     :ЦЕЛ; 
    dwFlags             :ЦЕЛ; 
    wShowWindow         :ОБХОД.Цел16;
    cbReserved2         :ОБХОД.Цел16;
    lpReserved2         :ЦЕЛ; 
    hStdInput           :ЦЕЛ; 
    hStdOutput          :ЦЕЛ; 
    hStdError           :ЦЕЛ; 
  КОН;
  PROCESS_INFORMATION=НАБОР
    hProcess            :ЦЕЛ; 
    hThread             :ЦЕЛ; 
    dwProcessId         :ЦЕЛ; 
    dwThreadId          :ЦЕЛ; 
  КОН;
 
 

(* используемые Win задачи *)
ЗАДАЧА GetProcAddress(hModule,lpProcName:ЦЕЛ):ЦЕЛ;       ВЫЗОВ "GetProcAddress"             ИЗ "kernel32.dll";
ЗАДАЧА GetProcessHeap():ЦЕЛ;                             ВЫЗОВ "GetProcessHeap"             ИЗ "kernel32.dll";
ЗАДАЧА HeapAlloc(hHeap,dwFlags,dwBytes:ЦЕЛ):ЦЕЛ;         ВЫЗОВ "HeapAlloc"                  ИЗ "kernel32.dll";
ЗАДАЧА HeapFree(hHeap,dwFlags,lpMem:ЦЕЛ);                ВЫЗОВ "HeapFree"                   ИЗ "kernel32.dll";
ЗАДАЧА CloseHandle(hObject:ЦЕЛ);                         ВЫЗОВ "CloseHandle"                ИЗ "kernel32.dll";
ЗАДАЧА FindClose(hFindFile:ЦЕЛ);                         ВЫЗОВ "FindClose"                  ИЗ "kernel32.dll";
ЗАДАЧА GlobalAlloc(uFlags,dwBytes:ЦЕЛ):ЦЕЛ;              ВЫЗОВ "GlobalAlloc"                ИЗ "kernel32.dll";
ЗАДАЧА GlobalLock(hMem:ЦЕЛ):ЦЕЛ;                         ВЫЗОВ "GlobalLock"                 ИЗ "kernel32.dll";
ЗАДАЧА GlobalUnlock(hMem:ЦЕЛ);                           ВЫЗОВ "GlobalUnlock"               ИЗ "kernel32.dll";
ЗАДАЧА GlobalFree(hMem:ЦЕЛ);                             ВЫЗОВ "GlobalFree"                 ИЗ "kernel32.dll";
ЗАДАЧА LocalAlloc(uFlags,uBytes:ЦЕЛ):ЦЕЛ;                ВЫЗОВ "LocalAlloc"                 ИЗ "kernel32.dll";
ЗАДАЧА LocalFree(hMem:ЦЕЛ):ЦЕЛ;                          ВЫЗОВ "LocalFree"                  ИЗ "kernel32.dll";
ЗАДАЧА GetStdHandle(nStdHandle:ЦЕЛ):ЦЕЛ;                 ВЫЗОВ "GetStdHandle"               ИЗ "kernel32.dll";
ЗАДАЧА WaitForSingleObject(hHandle,dwMilliseconds:ЦЕЛ);  ВЫЗОВ "WaitForSingleObject"        ИЗ "kernel32.dll";
ЗАДАЧА SetEnvironmentVariable(lpName-,lpValue-:ЦЕПЬ);    ВЫЗОВ "SetEnvironmentVariableW"    ИЗ "kernel32.dll";
ЗАДАЧА GetFileAttributes(lpFileName-:ЦЕПЬ):ЦЕЛ;          ВЫЗОВ "GetFileAttributesW"         ИЗ "kernel32.dll";
ЗАДАЧА GetCommandLine():ЦЕЛ;                             ВЫЗОВ "GetCommandLineW"            ИЗ "kernel32.dll";
ЗАДАЧА CreateDirectory(lpPathName-:ЦЕПЬ; lpSecurityAttributes:ЦЕЛ):КЛЮЧ;                       ВЫЗОВ "CreateDirectoryW" ИЗ "kernel32.dll";
ЗАДАЧА ReadFile(hFile,lpBuffer,nNumberOfBytesToRead,lpNumberOfBytesRead+,lpOverlapped:ЦЕЛ):ЦЕЛ;  ВЫЗОВ "ReadFile"       ИЗ "kernel32.dll";
ЗАДАЧА WriteFile(hFile,lpBuffer,nNumberOfBytesToWrite,lpNumberOfBytesWritten+,lpOverlapped:ЦЕЛ); ВЫЗОВ "WriteFile"      ИЗ "kernel32.dll";
ЗАДАЧА SetFilePointer(hFile,lDistanceToMove,lpDistanceToMoveHigh,dwMoveMethod:ЦЕЛ):ЦЕЛ;          ВЫЗОВ "SetFilePointer" ИЗ "kernel32.dll";

ЗАДАЧА CreateProcess(lpApplicationName:ЦЕЛ;
 lpCommandLine-:ЦЕПЬ;
 lpProcessAttributes,ThreadAttributes,bInheritHandles,dwCreationFlags,lpEnvironment,lpCurrentDirectory:ЦЕЛ;
 lpStartupInfo+:STARTUPINFO;
 lpProcessInformation+:PROCESS_INFORMATION):ЦЕЛ; ВЫЗОВ "CreateProcessW" ИЗ "kernel32.dll";

ЗАДАЧА GetEnvironmentVariable(lpName-,lpBuffer+:ЦЕПЬ; nSize:ЦЕЛ):ЦЕЛ; ВЫЗОВ "GetEnvironmentVariableW" ИЗ "kernel32.dll";
ЗАДАЧА SetFileAttributes(lpFileName-:ЦЕПЬ; dwFileAttributes:МНОЖ);    ВЫЗОВ "SetFileAttributesW"      ИЗ "kernel32.dll";
ЗАДАЧА FindFirstFile(lpFileName-:ЦЕПЬ; lpFindFileData+:ПоискФ):ЦЕЛ;   ВЫЗОВ "FindFirstFileW"          ИЗ "kernel32.dll";
ЗАДАЧА FindNextFile(hFindFile:ЦЕЛ; lpFindFileData+:ПоискФ):ЦЕЛ;       ВЫЗОВ "FindNextFileW"           ИЗ "kernel32.dll";
ЗАДАЧА GetCurrentDirectory(nBufferLength:ЦЕЛ; lpBuffer-:ЦЕПЬ):ЦЕЛ;    ВЫЗОВ "GetCurrentDirectoryW"    ИЗ "kernel32.dll";

ЗАДАЧА GetFullPathName(lpFileName-:ЦЕПЬ;
 nBufferLength:ЦЕЛ;
 lpBuffer-:ЦЕПЬ;
 lpFilePart+:ЦЕЛ):ЦЕЛ; ВЫЗОВ "GetFullPathNameW" ИЗ "kernel32.dll";

ЗАДАЧА CreateFile(lpFileName-:ЦЕПЬ;
 dwDesiredAccess,
 dwShareMode,
 lpSecurityAttributes,
 dwCreationDisposition,
 dwFlagsAndAttributes,
 hTemplateFile:ЦЕЛ):ЦЕЛ; ВЫЗОВ "CreateFileW" ИЗ "kernel32.dll";

ЗАДАЧА LoadKeyboardLayout(pwszKLID-:ЦЕПЬ; Flags:ЦЕЛ):ЦЕЛ;ВЫЗОВ "LoadKeyboardLayoutW"        ИЗ "user32.dll";
ЗАДАЧА VkKeyScanEx(ch:ЗНАК; dwhkl:ЦЕЛ):ЦЕЛ;              ВЫЗОВ "VkKeyScanExW"               ИЗ "user32.dll";
ЗАДАЧА OpenClipboard(hWndNewOwner:ЦЕЛ):КЛЮЧ;             ВЫЗОВ "OpenClipboard"              ИЗ "user32.dll";
ЗАДАЧА CloseClipboard();                                 ВЫЗОВ "CloseClipboard"             ИЗ "user32.dll";
ЗАДАЧА EmptyClipboard();                                 ВЫЗОВ "EmptyClipboard"             ИЗ "user32.dll";
ЗАДАЧА SetClipboardData(uFormat,hMem:ЦЕЛ);               ВЫЗОВ "SetClipboardData"           ИЗ "user32.dll";
ЗАДАЧА GetClipboardData(uFormat:ЦЕЛ):ЦЕЛ;                ВЫЗОВ "GetClipboardData"           ИЗ "user32.dll";
ЗАДАЧА IsClipboardFormatAvailable(format:ЦЕЛ):КЛЮЧ;      ВЫЗОВ "IsClipboardFormatAvailable" ИЗ "user32.dll";

 
 
(******************************************************************************)
ЗАДАЧА Связаться-(имя-:ЦЕПЬ):ЦЕЛ;                        ВЫЗОВ "LoadLibraryW"   ИЗ "kernel32.dll";
(* Связывание с ДПБ, имя которой <имя>. Возвращает ссылку на ДПБ или 0. *)
(******************************************************************************)
ЗАДАЧА Отвязаться-(ссылка:ЦЕЛ);                          ВЫЗОВ "FreeLibrary"    ИЗ "kernel32.dll";
(* Отказ от использования ДПБ. *)
(******************************************************************************)
ЗАДАЧА УдалитьФ-(имя-:ЦЕПЬ):КЛЮЧ;                        ВЫЗОВ "DeleteFileW"    ИЗ "kernel32.dll";
(* Удаляет файл с именем <имя>, возвращая ВКЛ в случае успеха. *)
(******************************************************************************)
ЗАДАЧА ПереименоватьФ-(староеимя-,новоеимя-:ЦЕПЬ):КЛЮЧ;  ВЫЗОВ "MoveFileW"      ИЗ "kernel32.dll";
(* Переименовывает файл со <староеимя> на <новоеимя>.
 * При успешном выполнении возвращает ВКЛ. *)
(******************************************************************************)
ЗАДАЧА Время-():ЦЕЛ;                                     ВЫЗОВ "GetTickCount"   ИЗ "kernel32.dll";
(* Возвращает время в мс, прошедшее от запуска Win. *)
(******************************************************************************)
ЗАДАЧА Спать-(мс:ЦЕЛ);                                   ВЫЗОВ "Sleep"          ИЗ "kernel32.dll";
(* Приостановить работу приложения на <мс> миллисекунд. *)
(******************************************************************************)
ЗАДАЧА КоторыйЧас-(сейчас+:Сейчас);                      ВЫЗОВ "GetSystemTime"  ИЗ "kernel32.dll";
(******************************************************************************)
ЗАДАЧА Гудок-(частота,длительность:ЦЕЛ);                 ВЫЗОВ "Beep"           ИЗ "kernel32.dll";

(******************************************************************************)
ЗАДАЧА СоздатьП-(имя-:ЦЕПЬ):КЛЮЧ;
(* Создаёт папку с именем <имя>, возвращая ВКЛ в случае успеха. *)
УКАЗ
  ВОЗВРАТ CreateDirectory(имя,0)
КОН СоздатьП;

(******************************************************************************)
ЗАДАЧА ЗакрытьФ-(фссылка:ЦЕЛ);
(* Закрывает файл по ссылке <фссылка>. *)
УКАЗ
  CloseHandle(фссылка)
КОН ЗакрытьФ;

(******************************************************************************)
ЗАДАЧА ФДляЧтения-(имя-:ЦЕПЬ):ЦЕЛ;
(* Открывает файл <имя> для чтения. При неудаче возвращает 0. *)
ПЕР
  ответ:ЦЕЛ;
УКАЗ
  ответ:=CreateFile(имя,МИН(ОБХОД.Цел32)(*80000000H*),1,0,3,80H,0);
  ЕСЛИ ответ = -1 ТО
    ВОЗВРАТ 0
  ИНАЧЕ
    ВОЗВРАТ ответ
  КОН
КОН ФДляЧтения;

(******************************************************************************)
ЗАДАЧА ФДляЗаписи-(имя-:ЦЕПЬ):ЦЕЛ;
(* Создает файл <имя> для записи. При неудаче возвращает 0. *)
ПЕР
  ответ:ЦЕЛ;
УКАЗ
  ответ:=CreateFile(имя,40000000H,1,0,2,80H,0);
  ЕСЛИ ответ = -1 ТО
    ВОЗВРАТ 0
  ИНАЧЕ
    ВОЗВРАТ ответ
  КОН
КОН ФДляЗаписи;

(******************************************************************************)
ЗАДАЧА ФДляПополнения-(имя-:ЦЕПЬ):ЦЕЛ;
(* Открывает (или создает, если не существует) файл с именем <имя> для записи
 * данных в его конец. При неудаче возвращает 0. *)
ПЕР
  ответ:ЦЕЛ;
  фссылка:ЦЕЛ;
УКАЗ
  фссылка:=CreateFile(имя,40000000H,1,0,4,80H,0);
  ЕСЛИ фссылка = -1 ТО
    ВОЗВРАТ 0
  КОН;
  ответ:=SetFilePointer(фссылка,0,0,2);
  ЕСЛИ ответ = -1 ТО
    ВОЗВРАТ 0
  КОН;
  ВОЗВРАТ фссылка
КОН ФДляПополнения;

(******************************************************************************)
ЗАДАЧА ЧитатьФ-(фссылка:ЦЕЛ; память+:ОБХОД.Ячейки; размер:ЦЕЛ):ЦЕЛ;
(* Читает из файла по ссылке <фссылка> в <память> данные размером <размер> ячеек.
 * Возвращает число прочитанных ячеек. *)
ПЕР
  ответ:ЦЕЛ;
УКАЗ
  ответ:=ReadFile(фссылка,ОБХОД.ПолучитьАдрес(память),размер,размер,0);
  ЕСЛИ ответ = 0 ТО
    ВОЗВРАТ 0
  КОН;
  ВОЗВРАТ размер
КОН ЧитатьФ;

(******************************************************************************)
ЗАДАЧА ПисатьФ-(фссылка:ЦЕЛ; память-:ОБХОД.Ячейки; размер:ЦЕЛ);
(* Записывает в <фссылка> из <память> данные размером <размер> ячеек. *)
УКАЗ
  WriteFile(фссылка,ОБХОД.ПолучитьАдрес(память),размер,размер,0)
КОН ПисатьФ;

(******************************************************************************)
ЗАДАЧА СвойстваФ-(имя-:ЦЕПЬ):МНОЖ;
(* Возвращает свойства файла <имя>. *)
ПЕР
  ответ:ЦЕЛ;
УКАЗ
  ответ:=GetFileAttributes(имя);
  ЕСЛИ ответ = -1 ТО
    ВОЗВРАТ {сфОшибкаЧтения}
  ИНАЧЕ
    ВОЗВРАТ ОБХОД.Значение(МНОЖ,ответ)
  КОН
КОН СвойстваФ;

(******************************************************************************)
ЗАДАЧА СменаСвойствФ-(имя-:ЦЕПЬ; свойства:МНОЖ);
(* Меняет свойства файла <имя> на <свойства>. Свойства можно
 * получать, объединяя постоянные <сф_>. *)
УКАЗ
  SetFileAttributes(имя,свойства)
КОН СменаСвойствФ;

(******************************************************************************)
ЗАДАЧА ПозицияФ-(фссылка:ЦЕЛ):ЦЕЛ;
(* Возвращает позицию, отсчитываемую от начала открытого файла с ссылкой <фссылка>. *)
УКАЗ
  ВОЗВРАТ SetFilePointer(фссылка,0,0,1)
КОН ПозицияФ;

(******************************************************************************)
ЗАДАЧА СменаПозицииФ-(фссылка,позиция:ЦЕЛ);
(* Меняет позицию в открытом файле с сылкой <фссылка> на <позиция>,
 * отсчитываемую от начала файла. *)
ПЕР
  ответ:ЦЕЛ;
УКАЗ
  ответ:=SetFilePointer(фссылка,позиция,0,0)
КОН СменаПозицииФ;

(******************************************************************************)
ЗАДАЧА ПервыйПоискФ-(путь-:ЦЕПЬ; поиск+:ПоискФ):КЛЮЧ;
(* Начинает поиск файлов в каталоге по образцу <путь>.
 * Например, "C:\Глагол\*.отд". При успешном завершении возвращает
 * ВКЛ, а результаты поиска заносятся в поисковый набор <поиск>. *)
ПЕР
  ответ,поз:ЦЕЛ;
УКАЗ
  ответ:=FindFirstFile(путь,поиск);
  ЕСЛИ ответ = -1 ТО
    ВОЗВРАТ ОТКЛ
  КОН;
  поиск.фссылка:=ответ;
  ВОЗВРАТ ВКЛ
КОН ПервыйПоискФ;

(******************************************************************************)
ЗАДАЧА СледующийПоискФ-(поиск+:ПоискФ):КЛЮЧ;
(* Продолжает поиск начатый действием <ПервыйПоискФ>. При успешном завершении
 * возвращает ВКЛ и результаты поиска заносятся в поисковый набор <поиск>. *)
УКАЗ
  ВОЗВРАТ FindNextFile(поиск.фссылка,поиск) # 0
КОН СледующийПоискФ;

(******************************************************************************)
ЗАДАЧА ОкончитьПоискФ-(поиск+:ПоискФ);
(* Оканчивает поиск начатый <ПервыйПоискФ>. *)
УКАЗ
  FindClose(поиск.фссылка)
КОН ОкончитьПоискФ;

(******************************************************************************)
ЗАДАЧА ТекущийПутьФ-(дискпуть+:ЦЕПЬ);
(* Записывает в <дискпуть> текущий путь. *)
ПЕР
  ответ:ЦЕЛ;
УКАЗ
  ответ:=GetCurrentDirectory(РАЗМЕР(дискпуть),дискпуть);
  ЕСЛИ ответ = 0 ТО
    дискпуть[0]:=0X
  КОН
КОН ТекущийПутьФ;

(******************************************************************************)
ЗАДАЧА МестоФ-(имя-,место+:ЦЕПЬ);
(* Переводит имя файла <имя> в местоположение файла <место>. Относительное
 * имя <имя> может содержать ".\" и "..". Если <имя> не содержит название
 * диска, то подставляется название текущего диска. *)
ПЕР
  ответ,адрес:ЦЕЛ;
УКАЗ
  ответ:=GetFullPathName(имя,РАЗМЕР(место),место,адрес);
  ЕСЛИ ответ = 0 ТО
    место[0]:=0X
  КОН
КОН МестоФ;

(******************************************************************************)
ЗАДАЧА ПолучитьКомСтроку-(куда+:ЦЕПЬ);
ПЕР
  адрес,поз:ЦЕЛ;
  зн:ЗНАК;
УКАЗ
  поз:=0;
  адрес:=GetCommandLine();
  ПОВТОРЯТЬ
    ОБХОД.ИзПамяти(адрес+поз*2,зн);
    куда[поз]:=зн;
    УВЕЛИЧИТЬ(поз)
  ДО (зн = 0X) ИЛИ (поз >= РАЗМЕР(куда))
КОН ПолучитьКомСтроку;

(******************************************************************************)
ЗАДАЧА ВзятьПамять-(размер:ЦЕЛ):ЦЕЛ;
(* Берёт у ОС кусок памяти в <размер> ячеек и обнуляет его.
 * Возвращает <адрес> этого куска и ссылку Win на него.
 * <ссылка> равная 0 означает, что Win не выделила память. *)
УКАЗ
  ВОЗВРАТ HeapAlloc(ссылкаНаСтог,8,размер)
КОН ВзятьПамять;

(******************************************************************************)
ЗАДАЧА ОтдатьПамять-(адрес:ЦЕЛ);
(* Отдаёт в ОС кусок памяти, взятый до этого с помощью ВзятьПамять. *)
УКАЗ
  HeapFree(ссылкаНаСтог,0,адрес)
КОН ОтдатьПамять;

(******************************************************************************)
ЗАДАЧА ЦепочкуВОбменник-(цепь-:ЦЕПЬ);
ПЕР
  длина,ссылка,адрес:ЦЕЛ;
УКАЗ
  длина:=ДЛИНА(цепь)*2; (* ячеек *)
  ЕСЛИ OpenClipboard(0) ТО
    EmptyClipboard();
    ссылка:=GlobalAlloc(2000H,длина+2);
    ЕСЛИ ссылка # 0 ТО
      адрес:=GlobalLock(ссылка);
      ЕСЛИ адрес # 0 ТО
        ОБХОД.Образ(ОБХОД.ПолучитьАдрес(цепь),адрес,длина);
        ОБХОД.ВПамять(адрес+длина,0X)
      КОН;
      GlobalUnlock(ссылка)
    КОН;
    SetClipboardData(13,ссылка);
    CloseClipboard()
  КОН
КОН ЦепочкуВОбменник;

(******************************************************************************)
ЗАДАЧА НайтиЗнак0(адрес:ЦЕЛ):ЦЕЛ;
ПЕР
  поз:ЦЕЛ;
  знак:ЗНАК;
УКАЗ
  поз:=-1;
  ПОВТОРЯТЬ 
    УВЕЛИЧИТЬ(поз);
    ОБХОД.ИзПамяти(адрес+поз*2,знак)
  ДО знак = 0X;
  ВОЗВРАТ поз
КОН НайтиЗнак0;

(******************************************************************************)
ЗАДАЧА РазмерЦепочкиОбменника-():ЦЕЛ;
ПЕР
  размер,ссылка,адрес:ЦЕЛ;
УКАЗ
  размер:=0;
  ЕСЛИ IsClipboardFormatAvailable(13) ТО
    ЕСЛИ OpenClipboard(0) ТО
      ссылка:=GetClipboardData(13);
      ЕСЛИ ссылка # 0 ТО
        адрес:=GlobalLock(ссылка);
        ЕСЛИ адрес # 0 ТО
          размер:=НайтиЗнак0(адрес)+1
        КОН;
        GlobalUnlock(ссылка)
      КОН;
      CloseClipboard()
    КОН
  КОН;
  ВОЗВРАТ размер
КОН РазмерЦепочкиОбменника;

(******************************************************************************)
ЗАДАЧА ЦепочкуИзОбменника-(цепь+:ЦЕПЬ);
ПЕР
  размер,ссылка,адрес:ЦЕЛ;
УКАЗ
  ЕСЛИ IsClipboardFormatAvailable(13) ТО
    ЕСЛИ OpenClipboard(0) ТО
      ссылка:=GetClipboardData(13);
      ЕСЛИ ссылка # 0 ТО
        адрес:=GlobalLock(ссылка);
        ЕСЛИ адрес # 0 ТО
          размер:=НайтиЗнак0(адрес)+1;
          ЕСЛИ размер > РАЗМЕР(цепь) ТО
            размер:=РАЗМЕР(цепь)
          КОН;
          ОБХОД.Образ(адрес,ОБХОД.ПолучитьАдрес(цепь),размер*2)
        КОН;
        GlobalUnlock(ссылка)
      КОН;
      CloseClipboard()
    КОН
  КОН
КОН ЦепочкуИзОбменника;

(******************************************************************************)
ЗАДАЧА ЧитатьИзПерОкружения-(имя-,значение+:ЦЕПЬ);
ПЕР
  ответ:ЦЕЛ;
УКАЗ
  ответ:=GetEnvironmentVariable(имя,значение,РАЗМЕР(значение));
  ЕСЛИ ответ = 0 ТО
    значение[0]:=0X
  КОН
КОН ЧитатьИзПерОкружения;

(******************************************************************************)
ЗАДАЧА ПисатьВПерОкружения-(имя-,значение-:ЦЕПЬ);
УКАЗ
  SetEnvironmentVariable(имя,значение)
КОН ПисатьВПерОкружения;

(******************************************************************************)
ЗАДАЧА Вызов-(комСтрока-:ЦЕПЬ);
(* Цель:  отработка команды ОС без завершения оболочки ОС
 * До:    <комСтрока> - отрабатываемая командная строка *)
ПЕР
  si:STARTUPINFO;
  pi:PROCESS_INFORMATION;
  команда:ЦЕПЬ[300];
  ответ:ЦЕЛ;
УКАЗ
  ОБНУЛИТЬ(si);
  si.cb:=44H;
  ОБНУЛИТЬ(pi);
  (* найдем командный обработчик ОС *)
  ЧитатьИзПерОкружения("COMSPEC",команда);
  (* работаем без завершения *)
  Цепь.Добавить(команда," /k ");
  Цепь.Добавить(команда,комСтрока);
  ответ:=CreateProcess(0,команда,0,0,0,10H,0,0,si,pi);
КОН Вызов;

(******************************************************************************)
ЗАДАЧА ВызовВФайл-(комСтрока-,имяФ-:ЦЕПЬ);
(* Цель:  отработка команды ОС с сохранением вывода в текстовый файл 
 *        и завершением оболочки ОС
 * До:    <комСтрока> - отрабатываемая командная строка
 *        <имяФ>      - имя выходного текстового файла *)
ПЕР
  sa:SECURITY_ATTRIBUTES;
  si:STARTUPINFO;
  pi:PROCESS_INFORMATION;
  команда:ЦЕПЬ[300];
  ответ,фссылка:ЦЕЛ;
УКАЗ
  (* найдем командный обработчик ОС *)
  ЧитатьИзПерОкружения("COMSPEC",команда);
  (* работаем с завершением *)
  Цепь.Добавить(команда," /c ");
  Цепь.Добавить(команда,комСтрока);
  (* SECURITY_ATTRIBUTES *)
  sa.nLength:=12; (* размер *)
  sa.lpSecurityDescriptor:=0;
  sa.bInheritHandle:=1; (* да *)
  (* фссылка должна наследоваться *)
  фссылка:=CreateFile(имяФ,40000000H,1,ОБХОД.ПолучитьАдрес(sa),2,8000000H,0);
  ЕСЛИ фссылка # -1 ТО
    ОБНУЛИТЬ(si);
    si.cb:=44H;
    si.dwFlags:=100H;
    si.hStdInput:=ссылкаНаВвод;
    si.hStdOutput:=фссылка;
    si.hStdError:=фссылка;
    ОБНУЛИТЬ(pi);
    ЕСЛИ CreateProcess(0,команда,0,0,1,8000000H,0,0,si,pi) # 0 ТО 
      (* команда начала свою работу *)
      WaitForSingleObject(pi.hProcess,-1);
      CloseHandle(pi.hThread);
      CloseHandle(pi.hProcess)
    КОН;
    CloseHandle(фссылка)
  КОН
КОН ВызовВФайл;

(******************************************************************************)
ЗАДАЧА ВинЗнакВКодКлавиши-(знак:ЗНАК):ЦЕЛ;
(* Цель:  перевод знака в код соответствующей клавиши *)
ПЕР
  раскладка:ЦЕЛ;
УКАЗ
  ЕСЛИ Буква.Русская(знак) ТО
    раскладка:=русРаскладка
  ИНАЧЕ
    раскладка:=латРаскладка
  КОН;
  ВОЗВРАТ VkKeyScanEx(знак,раскладка) ОСТАТОК 100H
КОН ВинЗнакВКодКлавиши;

(******************************************************************************) 
ЗАДАЧА АдресЗадачи-(ссылка:ЦЕЛ; имя-:ЦЕПЬ):ЦЕЛ;
(* Возвращает адрес задачи из связанной по ссылке <ссылка> ДПБ,
 * имя которой <имя>. *)
ПЕР
  уимя:РЯД 100 ИЗ ЯЧЦЕЛ;
УКАЗ
  Цепь.ВВин(имя,уимя);
  ВОЗВРАТ GetProcAddress(ссылка,ОБХОД.ПолучитьАдрес(уимя))
КОН АдресЗадачи; 

(******************************************************************************)
УКАЗ
  ссылкаНаВвод:=GetStdHandle(-10);
  ссылкаНаВывод:=GetStdHandle(-11);
  ссылкаНаСтог:=GetProcessHeap();
  (* считываем русскую раскладку клавиатуры *)
  русРаскладка:=LoadKeyboardLayout("00000419",0);
  латРаскладка:=LoadKeyboardLayout("00000409",0)
КОН ОС.

 
 


Вопросы, замечания и предложения высылайте на atimopheyev@yahoo.com

 
Главная     ◄Глагол     ◄Азбука     ◄Задачи на Глаголе     Примеры приложений ►   Среда разработки ►   Отладка программ ►   Отличия от Оберона ►   Отличия от Паскаля ►   Ассемблер ARM ►   Глагол для ARM ►   ? и Ответы